home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / s-img_wc.adb < prev    next >
Text File  |  1994-05-19  |  4KB  |  81 lines
  1. -----------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                        S Y S T E M . I M G _ W C                          --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.2 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with System.Storage_Elements; use System.Storage_Elements;
  26. with System.Img_C;
  27.  
  28. function System.Img_WC (V : Wide_Character; B : Address) return Natural is
  29.    Val    : constant Natural := Wide_Character'Pos (V);
  30.    Hi, Lo : Natural;
  31.    Flag   : Natural;
  32.  
  33.    package Cnv is new Address_To_Access_Conversions (Character);
  34.    use Cnv;
  35.  
  36. begin
  37.    --  If in range of standard character, use standard character routine
  38.  
  39.    if Val <= 16#FF# then
  40.       return System.Img_C (Character'Val (Val), B);
  41.  
  42.    --  Otherwise return an appropriate escape sequence (i.e. one that matches
  43.    --  the convention implemented by Scn.Wide_Char)
  44.  
  45.    else
  46.       To_Pointer (B + Storage_Offset (0)).all := ''';
  47.       To_Pointer (B + Storage_Offset (1)).all := Ascii.ESC;
  48.  
  49.       Hi := Val / 256;
  50.       Lo := Val mod 256;
  51.  
  52.       if Hi >= 32 and then Lo >= 32 then
  53.          To_Pointer (B + Storage_Offset (2)).all := Character'Val (Hi);
  54.          To_Pointer (B + Storage_Offset (3)).all := Character'Val (Lo);
  55.          To_Pointer (B + Storage_Offset (4)).all := ''';
  56.          return 5;
  57.  
  58.       else
  59.          Flag := 0;
  60.  
  61.          if Hi < 32 then
  62.             Hi := Hi + 32;
  63.             Flag := Flag + 1;
  64.          end if;
  65.  
  66.          if Lo < 32 then
  67.             Lo := Lo + 32;
  68.             Flag := Flag + 2;
  69.          end if;
  70.  
  71.          To_Pointer (B + Storage_Offset (2)).all := Ascii.Nul;
  72.          To_Pointer (B + Storage_Offset (3)).all := Character'Val (Flag);
  73.          To_Pointer (B + Storage_Offset (4)).all := Character'Val (Hi);
  74.          To_Pointer (B + Storage_Offset (5)).all := Character'Val (Lo);
  75.          To_Pointer (B + Storage_Offset (6)).all := ''';
  76.          return 7;
  77.       end if;
  78.    end if;
  79.  
  80. end System.Img_WC;
  81.